home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd25.zip / MUTT2.ZIP / PICTURE.MUT < prev    next >
Lisp/Scheme  |  1992-11-09  |  24KB  |  680 lines
  1. ;; "Picture mode" -- editing using quarter-plane screen model.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3. ;; Principal author K. Shane Hartman
  4. ;; Converted to Mutt 6/88 C Durland
  5.  
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10.   ;; Eliminate whitespace at ends of lines.
  11. (defun remove-trailing-whitespace
  12. {
  13.   (int mark-id)
  14.  
  15.   (set-mark (mark-id (create-mark)))
  16.   (beginning-of-buffer)
  17.   (re-search-replace '\ +$' "")
  18.   (goto-mark mark-id)(free-mark mark-id)
  19.   (msg "Removed trailing whitespace")
  20. })
  21.  
  22.     ; move to the next tab stop in the tabs list
  23. (defun tab-to-tab-stop (int num-tabs) (array byte tabs 1)
  24. {
  25.   (int i col)
  26.  
  27.   (col (current-column))
  28.   (for (i 0) (and (< i num-tabs)(>= col (tabs i))) (+= i 1) ())
  29.   (if (< i num-tabs) { (to-col (i (tabs i))) i } col)
  30. })
  31.  
  32. (include me2.h)
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. ;;;;;;;;;;;;;;;; Picture Movement Commands ;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37.  
  38.   ;; Move to column in current line.
  39.   ;; Differs from move-to-column in that it creates or modifies whitespace
  40.   ;;   if necessary to attain exactly the specified column.
  41. (defun move-to-column-force (int column) HIDDEN
  42. {
  43.   (current-column column) (to-col column)
  44. })
  45.  
  46.   ;; Position point after last non-blank character on current line.
  47.   ;; With ARG not nil, move forward ARG - 1 lines first.
  48.   ;; If scan reaches end of buffer, stop there without error.
  49. (defun picture-end-of-line
  50. {
  51.   (if (arg-flag) (forward-line (- (arg-prefix) 1)))
  52.   (end-of-line)
  53.   (if (previous-character)
  54.   {
  55.     (while (is-space) (previous-character))
  56.     (next-character)
  57.   })
  58. })
  59.  
  60.   ;; Move cursor right, making whitespace if necessary.
  61.   ;; With argument, move that many columns.
  62. (defun picture-forward-column
  63. {
  64.   (move-to-column-force (+ (current-column) (arg-prefix)))
  65. })
  66.  
  67.   ;; Move cursor left, making whitespace if necessary.
  68.   ;; With argument, move that many columns.
  69. (defun picture-backward-column
  70. {
  71.   (move-to-column-force (- (current-column) (arg-prefix)))
  72. })
  73.  
  74.   ;; Move vertically down, making whitespace if necessary.
  75.   ;; With argument, move that many lines.
  76. (defun picture-move-down
  77. {
  78.   (int col)
  79.  
  80.   (col (current-column))
  81.   (picture-newline (arg-prefix))
  82.   (move-to-column-force col)
  83. })
  84.  
  85.   ;; Move vertically up, making whitespace if necessary.
  86.   ;; With argument, move that many lines.
  87. (defun picture-move-up
  88. {
  89.   (int col n)
  90.  
  91.   (n (arg-prefix))
  92.   (col (current-column))
  93.  
  94.   (while (>= (-= n 1) 0)
  95.     (if (not (forward-line -1))    ; at top of buffer
  96.     { (beginning-of-buffer)(open-line) })
  97.   )
  98.   (move-to-column-force col)
  99. })
  100.  
  101.   ;; Amount to move vertically after text character in Picture mode.
  102. (int picture-vertical-step)
  103.  
  104.   ;; Amount to move horizontally after text character in Picture mode.
  105. (int picture-horizontal-step)
  106.  
  107.   ;; Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
  108.   ;; The mode line is updated to reflect the current direction.
  109. (defun picture-set-motion (int vert horiz) HIDDEN
  110. {
  111.   (picture-vertical-step vert)
  112.   (picture-horizontal-step horiz)
  113. ;  (setq mode-name
  114. ;    (format "Picture:%s"
  115. ;        (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
  116. ;                 '(nw up ne left none right sw down se)))))
  117.   (major-mode
  118.     (concat "Picture:"
  119.       (switch (+ 1 horiz (* 3 (+ 1 vert)))
  120.     0 "NW"
  121.     1 "up"
  122.     2 "NE"
  123.     3 "left"
  124.     4 "none"
  125.     5 "right"
  126.     6 "SW"
  127.     7 "down"
  128.     8 "SE"
  129.       )))
  130. })
  131.  
  132.   ;; Move right after self-inserting character in Picture mode.
  133. (defun picture-movement-right { (picture-set-motion 0 1) })
  134.  
  135.   ;; Move left after self-inserting character in Picture mode.
  136. (defun picture-movement-left { (picture-set-motion 0 -1) })
  137.  
  138.   ;; Move up after self-inserting character in Picture mode.
  139. (defun picture-movement-up { (picture-set-motion -1 0) })
  140.  
  141.   ;; Move down after self-inserting character in Picture mode.
  142. (defun picture-movement-down { (picture-set-motion 1 0) })
  143.  
  144.   ;; Move up and left after self-inserting character in Picture mode.
  145. (defun picture-movement-nw { (picture-set-motion -1 -1) })
  146.  
  147.   ;; Move up and right after self-inserting character in Picture mode.
  148. (defun picture-movement-ne { (picture-set-motion -1 1) })
  149.  
  150.   ;; Move down and left after self-inserting character in Picture mode.
  151. (defun picture-movement-sw { (picture-set-motion 1 -1) })
  152.  
  153.   ;; Move down and right after self-inserting character in Picture mode.
  154. (defun picture-movement-se { (picture-set-motion 1 1) })
  155.  
  156.   ;; Move in direction of picture-vertical-step and picture-horizontal-step.
  157.   ;; With ARG do it that many times.
  158.   ;; Useful for delineating rectangles in conjunction with diagonal
  159.   ;;   picture motion.
  160.   ;; Do apropos picture-movement  to see commands which control motion.
  161. (defun picture-move
  162. {
  163.   (int col)
  164.  
  165.   (col (+ (current-column) (* picture-horizontal-step (arg-prefix))))
  166.   (cond
  167.     (< picture-vertical-step 0) (picture-move-up)
  168.     (> picture-vertical-step 0) (picture-move-down)
  169.   )
  170.   (move-to-column-force col)
  171. })
  172.  
  173.   ;; Move point in direction opposite of current picture motion in Picture mode.
  174.   ;; With ARG do it that many times.
  175.   ;; Useful for delineating rectangles in conjunction with diagonal
  176.   ;;   picture motion.
  177.   ;; Do apropos picture-movement  to see commands which control motion.
  178. (defun picture-move-reverse
  179. {
  180.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  181.   (picture-move)
  182.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  183. })
  184.  
  185. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  186. ;;;;;;;;;; Picture insertion and deletion ;;;;;;;;;;;;;;;;;;;;;;;;;;
  187. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  188.  
  189.   ;; Insert character in place of character previously at the cursor.
  190.   ;; The cursor then moves in the direction previously specified
  191.   ;;   with the picture-movement- commands.
  192.   ;; Do apropos  picture-movement  to see those commands.
  193. (defun picture-insert (string c)(int n) HIDDEN
  194. {
  195.   (int i)
  196.  
  197.   (i n)
  198.   (while (> i 0)
  199.   {
  200.     (-= i 1)
  201.     (move-to-column-force (+ 1 (current-column)))    ; break up any tabs
  202.     (delete-previous-character)
  203.     (insert-text c)
  204.     (previous-character)
  205.     (arg-prefix 1)(picture-move)
  206.   })
  207. })
  208.  
  209. (defun picture-self-insert
  210. {
  211.   (picture-insert (convert-to CHARACTER (key-pressed)) (arg-prefix))
  212. })
  213.  
  214.   ;; Clear out ARG columns after point without moving.
  215. (defun picture-clear-column
  216. {
  217.   (int col)
  218.  
  219.   (set-mark)
  220.   (col (current-column (+ (current-column) (arg-prefix))))
  221.   (delete-region)(to-col col)
  222.   (swap-marks)
  223. })
  224.  
  225.   ;; Clear out ARG columns before point, moving back over them.
  226. (defun picture-backward-clear-column
  227. {
  228.   (if (== 1 (current-column)) (done))    ; no op if at begining of line
  229.   (move-to-column-force (- (current-column) (arg-prefix)))
  230.   (picture-clear-column)
  231. })
  232.  
  233.   ;; Clear out rest of line; if at end of line, advance to next line.
  234.   ;; Cleared-out line text goes into the kill ring, as do
  235.   ;;   newlines that are advanced over.
  236.   ;; With argument, clear out (and save in kill ring) that many lines.
  237. (defun picture-clear-line
  238. {
  239.   (int n)
  240.  
  241.   (if (arg-flag)
  242.     {
  243.       (arg-prefix (n (arg-prefix))) (cut-line)
  244.       (arg-prefix n)(newline)
  245.     }
  246.     {
  247.       (if (looking-at '.+$')(cut-line))
  248.         ; tack a newline to end of cut buffer
  249.       (append-to-bag CUT-BUFFER APPEND-TEXT "^J")
  250.       (forward-line 1)
  251.     }
  252.   )
  253. })
  254.  
  255.   ;; Move to the beginning of the following line.
  256.   ;; With argument, moves that many lines (up, if negative argument).
  257.   ;; Always moves to the beginning of a line.
  258. (defun picture-newline
  259. {
  260.   (int n)
  261.  
  262.   (if (< (n (arg-prefix)) 0)    ; negative arg => move up
  263.     (forward-line n)
  264.     (while (>= (-= n 1) 0) (if (not (forward-line 1)) (newline)))
  265.   )
  266. })
  267.  
  268.   ;; Insert an empty line after the current line.
  269.   ;; With positive argument insert that many lines.
  270. (defun picture-open-line
  271. {
  272.   (int